home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Utilities / Siege Watch 2.0 / Preferences.p < prev    next >
Encoding:
Text File  |  1994-04-23  |  4.0 KB  |  167 lines  |  [TEXT/PJMM]
  1. { Preferences.p --> functions related to maintaining a }
  2. { preference file }
  3. unit Preferences;
  4. interface
  5.     uses
  6.         Globals;
  7. { function prototypes }
  8.     procedure DoPrefDefault (var myPrefs: PrefRecord);
  9.     procedure GetPreferences (var myPrefs: PrefRecord);
  10.     procedure SaveMyPrefs (myPrefs: PrefRecord);
  11.     procedure ValidatePrefs (var myPrefs: PrefRecord);
  12. implementation
  13.     uses
  14.         Folders, MySpeech, Utility;
  15.     const
  16.         VERSION = 2;
  17.         PREF_NAME_ID = 414;
  18.         CREATOR = 'Slik';
  19.         DEFAULT_BITE_FREQ = 800;
  20.  
  21.     procedure DoPrefDefault (var myPrefs: PrefRecord);
  22.         var
  23.             iErr: OSErr;
  24.     begin
  25.         with myPrefs do
  26.             begin
  27.                 version := VERSION;
  28.                 zoomed := TRUE;
  29.                 chimed := FALSE;
  30.                 sayDays := FALSE;
  31.                 sayHours := FALSE;
  32.                 sayBites := FALSE;
  33.                 useSysVoice := TRUE;
  34.                 pitch := X2Fix(50.0);
  35.                 wpm := X2Fix(160.0);
  36.                 modulation := X2Fix(50.0);
  37.                 volume := X2Fix(0.50);
  38.                 keepVoice := TRUE;
  39.                 useDaemon := TRUE;
  40.                 if IsSpeechAvailable then
  41.                     begin
  42.                         iErr := MakeVoiceSpec('mtk2', '1   ', @voice);
  43.                     end;
  44.                 unused2 := 0;
  45.                 unused3 := 1;
  46.                 biteFreq := DEFAULT_BITE_FREQ;
  47.             end;
  48.     end;
  49. { the original watch didn't have these values, we would crash if }
  50. { they were equal to zero }
  51.  
  52.     procedure ValidatePrefs (var myPrefs: PrefRecord);
  53.         var
  54.             ok: Boolean;
  55.             pitchVal, wpmVal, volVal, modVal: extended;
  56.     begin
  57.         ok := TRUE;
  58.         with myPrefs do
  59.             begin
  60.                 if version < VERSION then
  61.                     version := version;
  62.                 pitchVal := Fix2X(pitch);
  63.                 if FALSE = CompareMyValues(pitchVal, MAX_PITCH, MIN_PITCH, ok) then
  64.                     pitch := X2Fix(50.0);
  65.  
  66.                 wpmVal := Fix2X(wpm);
  67.                 if False = CompareMyValues(wpmVal, MAX_WPM, MIN_WPM, ok) then
  68.                     wpm := X2Fix(160.0);
  69.  
  70.                 volVal := Fix2X(volume);
  71.                 if False = CompareMyValues(volVal, MAX_VOL, MIN_VOL, ok) then
  72.                     volume := X2Fix(0.5);
  73.  
  74.                 modVal := Fix2X(volume);
  75.                 if False = CompareMyValues(modVal, MAX_MOD, MIN_MOD, ok) then
  76.                     volume := X2Fix(0.5);
  77.                 if (biteFreq > 16667) or (biteFreq < 0) then
  78.                     biteFreq := DEFAULT_BITE_FREQ;
  79.             end;
  80.     end;
  81.  
  82.     function GetPrefNameAndFolder (var prefNameH: StringHandle;
  83.                                     var vRefNum: integer;
  84.                                     var parID: LONGINT): OSErr;
  85.         var
  86.             iErr: OSErr;
  87.     begin
  88.         prefNameH := GetString(PREF_NAME_ID);
  89.         iErr := FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, vRefNum, parID);
  90.         if (prefNameH = nil) or (prefNameH^^ = '') then
  91.             begin
  92.                 GetPrefNameAndFolder := bdNamErr;
  93.             end
  94.         else
  95.             begin
  96.                 GetPrefNameAndFolder := iErr;
  97.             end;
  98.     end;
  99.  
  100.     function GetPrefRefNum (var vRefNum: integer): OSErr;
  101.         var
  102.             iErr: OSErr;
  103.             folderRefNum: integer;
  104.             parID: LONGINT;
  105.             prefNameH: StringHandle;
  106.     begin
  107.         iErr := GetPrefNameAndFolder(prefNameH, folderRefNum, parID);
  108.         if iErr = 0 then
  109.             begin
  110.                 iErr := HOpen(folderRefNum, parID, prefNameH^^, 2, vRefNum);
  111.             end;
  112.         GetPrefRefNum := iErr;
  113.     end;
  114.  
  115.     procedure SaveMyPrefs (myPrefs: PrefRecord);
  116.         var
  117.             iErr: OSErr;
  118.             vRefNum, folderRefNum: integer;
  119.             inOutCount, parID: LONGINT;
  120.             bufPtr: Ptr;
  121.             prefNameH: StringHandle;
  122.     begin
  123.         iErr := GetPrefRefNum(vRefNum);
  124.         if iErr = fnfErr then
  125.             begin
  126.                 iErr := GetPrefNameAndFolder(prefNameH, folderRefNum, parID);
  127.                 if iErr = 0 then
  128.                     begin
  129.                         iErr := HCreate(folderRefNum, parID, prefNameH^^, CREATOR, 'Pref');
  130.                         if iErr = 0 then
  131.                             begin
  132.                                 iErr := HOpen(folderRefNum, parID, prefNameH^^, 2, vRefNum);
  133.                             end;
  134.                     end;
  135.             end;
  136.         if iErr = 0 then
  137.             begin
  138.                 inOutCount := SIZEOF(PrefRecord);
  139.                 bufPtr := Ptr(@myPrefs);
  140.                 iErr := FSWrite(vRefNum, inOutCount, bufPtr);
  141.                 iErr := FSClose(vRefNum);
  142.             end;
  143.     end;
  144.  
  145.     procedure GetPreferences (var myPrefs: PrefRecord);
  146.         var
  147.             iErr: OSErr;
  148.             vRefNum: integer;
  149.             inOutCount: LONGINT;
  150.             bufPtr: Ptr;
  151.             prefNameH: StringHandle;
  152.     begin
  153.         iErr := GetPrefRefNum(vRefNum);
  154.         if iErr = 0 then
  155.             begin
  156.                 inOutCount := SIZEOF(PrefRecord);
  157.                 bufPtr := Ptr(@myPrefs);
  158.                 iErr := FSRead(vRefNum, inOutCount, bufPtr);
  159.                 iErr := FSClose(vRefNum);
  160.             end
  161.         else if iErr = fnfErr then
  162.             begin
  163.                 SaveMyPrefs(myPrefs);
  164.             end;
  165.     end;
  166.  
  167. end.